home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / fpkpas92.zip / SRCRTL.ZIP / RTL / DOS / IBM.PPI < prev    next >
Text File  |  1997-07-01  |  4KB  |  150 lines
  1. { IBM.PPI }
  2.  
  3. function DetectVESA:Boolean;
  4. var Result:longint;
  5. begin
  6.   Result:=Global_dos_alloc($0200);
  7.      Sel:=word(Result);
  8.      Seg:=word(Result shr 16);
  9.      dregs.RealSP:=0;      dregs.RealSS:=0;
  10.      dregs.RealES:=Seg;    dregs.RealEDI:=0;
  11.      dregs.RealEAX:=$4F00; RealIntr($10,dregs);  
  12.      if isDPMI 
  13.        then MoveLong(sel,@VGAInfo,256)
  14.        else Move(pointer((seg shl 4)+core)^,VGAInfo,256);
  15.   global_dos_free(sel); 
  16.   DetectVesa:=(dregs.RealEAX and $FF=$4F);
  17.   isVESA2:=VGAInfo.VESAHiVersion=2;
  18. end;
  19.  
  20. function GetVESAInfo( Mode : WORD ):Boolean;
  21. var Result:longint;
  22. begin
  23.   Result:=Global_dos_alloc($0200);
  24.      Sel:=word(Result);
  25.      Seg:=word(Result shr 16);
  26.      dregs.RealECX:=mode;
  27.      dregs.RealSP:=0;      dregs.RealSS:=0;
  28.      dregs.RealES:=Seg;    dregs.RealEDI:=0;
  29.      dregs.RealEAX:=$4F01; RealIntr($10,dregs);
  30.      if isDPMI 
  31.        then MoveLong(sel,@VESAInfo,256)
  32.        else Move(Pointer((seg shl 4)+core)^,VESAINFO,256);
  33.   global_dos_free(sel);
  34.   
  35.   if (dregs.RealEAX and $ff) =$4F then 
  36.     begin
  37.       GetVESAInfo:=true;
  38.       BytesPerLine:=VESAInfo.BPL;
  39.       case VESAInfo.BitsPerPixel of
  40.        8     : BytesPerPixel:=1;
  41.        15,16 : BytesPerPixel:=2;
  42.        24    : begin
  43.                Oh_Kacke('24-Bit Modis nicht implementiert !');
  44.                exit;
  45.                end;
  46.       end;
  47.      _maxx:=VESAInfo.XResolution;
  48.      _maxy:=VESAInfo.YResolution;
  49.      
  50.      WinSize:=VESAInfo.Winsize*1024;
  51.      WinLoMask:=WinSize-1;
  52.      case VESAInfo.WinSize of
  53.         64 : WinShift:=16;      { x div 65536 = x shr 16 }
  54.         32 : WinShift:=15;      { x div 32768 = x shr 15 }
  55.         16 : WinShift:=14;      { ... }
  56.          8 : WinShift:=13;
  57.          4 : WinShift:=12;
  58.          2 : WinShift:=11;
  59.          1 : WinShift:=10;
  60.      end;
  61.      Granularity:=VESAInfo.WinGranularity;
  62.      Granular:=VESAInfo.WinSize div Granularity;
  63.      case Granular of
  64.         32 : GranShift:=5;
  65.         16 : GranShift:=4; 
  66.          8 : GranShift:=3;
  67.          4 : GranShift:=2;
  68.          2 : GranShift:=1;
  69.          1 : GranShift:=0;
  70.      end;
  71.      { set selector for writing }
  72.      if isDPMI then begin
  73.        set_segment_base_address(seg_write,$A000 shl 4);
  74.        set_segment_limit(seg_write,$FFFF);
  75.        seg_read:=seg_write;
  76.      end;
  77.      SwitchCS:=hi(VESAInfo.RealWinFuncPtr);
  78.      SwitchIP:=lo(VESAInfo.RealWinFuncPtr);
  79.    end else GetVESAInfo:=false;
  80. end;
  81.  
  82. function SetVESAMode(Mode:WORD):Boolean;
  83. begin
  84.   dregs.RealEBX:=Mode;
  85.   dregs.RealSP:=0;      dregs.RealSS:=0;
  86.   dregs.RealEAX:=$4F02; RealIntr($10,dregs);
  87.   if (dregs.RealEAX and $FF) <> $4F then begin
  88.     writeln('Coudnt initialize VESAMode ',HexStr(mode,4));
  89.     SetVESAMode:=false;
  90.   end
  91.   else SetVESAMode:=true;
  92. end;
  93.  
  94. function GetVESAMode:Integer;
  95. begin
  96.   dregs.RealSP:=0;      dregs.RealSS:=0;
  97.   dregs.RealEAX:=$4F03; RealIntr($10,dregs);
  98.   GetVESAMode:=lo(dregs.RealEBX);
  99. end;
  100.  
  101. procedure InitVESA;
  102. var RM:Word;
  103. begin
  104.   isDPMI:=false;
  105.   rm:=get_run_mode;
  106.   case rm of
  107.     0 : writeln('unknown mode');
  108.     1 : writeln('RAW mode');
  109.     2 : writeln('XMS detected');
  110.     3 : writeln('VCPI detected');
  111.     4 : begin writeln('DPMI detected'); 
  112.               isDPMI:=true; 
  113.               end;
  114.   end; { case }
  115.   if isDPMI then begin
  116.     seg_write:=allocate_ldt_descriptors(1);
  117.     seg_read:=allocate_ldt_descriptors(1);
  118.   end else begin
  119.     seg_write:=get_DS;
  120.     seg_read:=get_DS;
  121.   end;
  122. end;
  123.  
  124. procedure DoneVESA;
  125. begin
  126.   if isDPMI then begin
  127.     free_ldt_descriptor(seg_read);
  128.     free_ldt_descriptor(seg_write);
  129.   end;
  130. end;
  131.  
  132. procedure Switchbank(bank:longint);
  133. begin
  134.   asm
  135.     leal   _DREGS,%edi
  136.     movl   bank,%eax
  137.     movzbl _GRANSHIFT,%ecx
  138.     shll   %cl,%eax
  139.     movl   %eax,20(%edi)    // RealEDX
  140.     movw   _SWITCHCS,%ax
  141.     movw   %ax,44(%edi)     // RealCS
  142.     movw   _SWITCHIP,%ax    // RealIP
  143.     movw   %ax,42(%edi)    
  144.     xorl   %ecx,%ecx
  145.     movl   %ecx,46(%edi)    // RealSS,RealSP
  146.     movl   %ecx,16(%edi)    // RealEBX }
  147.     movw   $0x0301,%ax
  148.     int    $0x31
  149.   end;
  150. end;